home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / MAINCASE.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  24KB  |  877 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "vars.h"
  14. #include "gvars.h"
  15. #include "ops.h"
  16. #include "segment.h"
  17. #include "dbxp.h"
  18. #include "namp.h"
  19. #include "procp.h"
  20. #include "exprp.h"
  21. #include "setp.h"
  22. #include "genp.h"
  23. #include "statp.h"
  24. #include "miscp.h"
  25. #include "gmiscp.h"
  26. #include "smiscp.h"
  27. #include "segmentp.h"
  28. #include "declp.h"
  29. #include "typep.h"
  30. #include "packp.h"
  31. #include "gutilp.h"
  32. #include "axqrp.h"
  33. #include "sepp.h"
  34. #include "maincasp.h"
  35.  
  36. static void compile_line();
  37.  
  38. void compile(Node node)                                            /*;compile*/
  39. {
  40.     /* Generates one TREE statement */
  41.  
  42.     Node     expr_node;
  43.     Symbol    junk_var;
  44.     Tuple    case_table;
  45.     Tuple    tup;
  46.     Const    cond_val;
  47.     Tuple    labtup;
  48.     int        lablev;
  49.  
  50.     Node    
  51.       pre_node, post_node, decl_node, id_list_node, type_node, init_node,
  52.       stmt_node, var_node, exp_node, if_list_node, else_node, cond_node,
  53.       body_node, cases_node, id_node, stmts_node, handler_node, proc_node,
  54.       args_node, obj_node, package_tasks_node,
  55.       entry_node, alt_node, acc_node, delay_node, call_node, stmts1_node,
  56.       stmts2_node, task_node, separate_unit_node, label_node, others_node,
  57.       n, temp_node;
  58.     Tuple   condition_list, id_list, task_list, select_list, case_bodies;
  59.     Symbol   label_name, type_name, proc_name, new_name, old_name, entry_name,
  60.       exception_name, package_tasks_name, else_part, dont_exit, end_if,
  61.       true_guard, end_alt, i_subt;
  62.     Tuple   except_names, predef_tuple;
  63.     Tuple        labs;
  64.     int        nesting_depth, lineno, flag, tag, i;
  65.     int        guarded;
  66.     /* DECL */
  67.     Fortup    ft1;
  68.     int         function_code;
  69.     Const    ival;
  70.     int        ikind;
  71.     Segment    init_val;
  72.  
  73. #ifdef TRACE
  74.     if (debug_flag)
  75.         gen_trace_node("COMPILE", node);
  76. #endif
  77.  
  78. #ifdef DEBUG
  79.     if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
  80. #endif
  81.     switch(N_KIND(node)) {
  82.  
  83.     case(as_opt):          /* OPT_NODE */
  84.         break;
  85.  
  86.     case(as_deleted):      /* Deleted by expander */
  87.         break;
  88.  
  89.     case(as_insert):       /* Inserted by expander */
  90.         FORTUP(pre_node=(Node), N_LIST(node), ft1);
  91.             compile(pre_node);
  92.         ENDFORTUP(ft1);
  93.         post_node = N_AST1(node);
  94.         compile(post_node);
  95.         break;
  96.  
  97.     case(as_discard):     /* Some check to evaluate and discard */
  98.         expr_node = N_AST1(node);
  99.         junk_var    = new_unique_name("junk"); /* TBSL: Reusing same variable */
  100.         next_local_reference(junk_var);
  101.         gen_ks(I_DECLARE, kind_of(N_TYPE(node)), junk_var);
  102.  
  103.         gen_value(expr_node);
  104.         gen_ksc(I_POP, kind_of(N_TYPE(node)), junk_var, "Used only for check");
  105.         break;
  106.  
  107.     /* Chapter 2. Lexical elements
  108.      *------------
  109.      * 2.8 Pragmas
  110.      */
  111.     case(as_pragma):       /*TBSL(JC)    pragmas */
  112.         break;
  113.  
  114.     case(as_arg):          /*TBSL(JC)    arguments for pragmas */
  115.         break;
  116.  
  117.     /* Chapter 3. Declarations and types */
  118.     case(as_labels):
  119.         break;
  120.  
  121.     /* 3.1 Declarations */
  122.     case(as_declarations):
  123.         FORTUP(decl_node=(Node), N_LIST(node), ft1);
  124.             compile(decl_node);
  125.         ENDFORTUP(ft1);
  126.         break;
  127.  
  128.     /* 3.2 Objects and named numbers */
  129.     case(as_const_decl):
  130.         id_list_node = N_AST1(node);
  131.         type_node = N_AST2(node);
  132.         init_node = N_AST3(node);
  133.  
  134.         /* Generate pre-statements */
  135.         while (N_KIND(init_node) == as_insert) {
  136.             FORTUP(pre_node=(Node), N_LIST(init_node), ft1);
  137.                 compile(pre_node);
  138.             ENDFORTUP(ft1);
  139.             init_node = N_AST1(init_node);
  140.         }
  141.  
  142.         id_list   = N_LIST(id_list_node);
  143.         type_name = N_UNQ(type_node);
  144.         create_object(id_list, type_name, init_node, TRUE);
  145.  
  146.         TASKS_DECLARED |= (int) CONTAINS_TASK(type_name);
  147.         break;
  148.  
  149.     case(as_obj_decl):
  150.         id_list_node = N_AST1(node);
  151.         type_node = N_AST2(node);
  152.         init_node = N_AST3(node);
  153.  
  154.         /* Generate pre-statements */
  155.         while (N_KIND(init_node) == as_insert) {
  156.             FORTUP(pre_node=(Node), N_LIST(init_node), ft1);
  157.                 compile(pre_node);
  158.             ENDFORTUP(ft1);
  159.             init_node = N_AST1(init_node);
  160.         }
  161.  
  162.         id_list   = N_LIST(id_list_node);
  163.         type_name = N_UNQ(type_node);
  164.         create_object(id_list, type_name, init_node, FALSE);
  165.  
  166.         TASKS_DECLARED |= (int)CONTAINS_TASK(type_name);
  167.         break;
  168.  
  169.     case(as_num_decl):
  170.         break;
  171.  
  172.     /* 3.3 Types and subtypes */
  173.     case(as_type_decl):
  174.         id_node = N_AST1(node);
  175.         type_name = N_UNQ(id_node);
  176.         gen_type(type_name);
  177.         break;
  178.  
  179.     case(as_subtype_decl):
  180.         id_node = N_AST1(node);
  181.         type_name = N_UNQ(id_node);
  182.         gen_subtype(type_name);
  183.         break;
  184.  
  185.     /* Chapter 5. Statements */
  186.     case(as_null_s):
  187.         break;
  188.  
  189.     case(as_line_no):
  190.         NB_STATEMENTS += 1;
  191.         lineno = (int) N_VAL(node);
  192.         ada_line = lineno;
  193. #ifdef MACHINE_CODE
  194.         if (debug_line > 0 && lineno >= debug_line)
  195.             compile_line();
  196. #endif
  197.         if (line_option)
  198.             gen_i(I_STMT, lineno);
  199.         break;
  200.  
  201.     /* 5.1 Simple and compound statements */
  202.     case(as_statements):
  203.         stmts_node = N_AST1(node);
  204.         label_node = N_AST2(node);
  205.         labs = tup_new(0);
  206.         FORTUP(n=(Node), N_LIST(label_node), ft1);
  207.             if (!tup_mem((char *) N_UNQ(n), labs))
  208.                 labs =tup_with(labs, (char *)N_UNQ(n));
  209.         ENDFORTUP(ft1);
  210.         FORTUP(label_name=(Symbol), labs, ft1);
  211.             labelmap_put(label_name, LABEL_STATIC_DEPTH, (char *)CURRENT_LEVEL);
  212.             next_local_reference(label_name);
  213.             gen_s(I_SAVE_STACK_POINTER, label_name);
  214.         ENDFORTUP(ft1);
  215.         FORTUP(stmt_node=(Node), N_LIST(stmts_node), ft1);
  216.             compile(stmt_node);
  217.         ENDFORTUP(ft1);
  218.         tup_free(labs);
  219.         break;
  220.  
  221.     case(as_statement):
  222.         label_node = N_AST1(node);
  223.         stmt_node = N_AST2(node);
  224.         labs = tup_new(0);
  225.         FORTUP(n=(Node), N_LIST(label_node), ft1);
  226.             if (!tup_mem((char *) N_UNQ(n), labs))
  227.                 labs =tup_with(labs, (char *) N_UNQ(n));
  228.         ENDFORTUP(ft1);
  229.         FORTUP(label_name=(Symbol), labs, ft1);
  230.             gen_s(I_LABEL, label_name);
  231.         ENDFORTUP(ft1);
  232.         compile(stmt_node);
  233.         tup_free(labs);
  234.         break;
  235.  
  236.     /* 5.2 Assignment statement */
  237.     case(as_assignment): 
  238.     case(as_static_comp):
  239.         var_node = N_AST1(node);
  240.         exp_node = N_AST2(node);
  241.         type_name           = get_type(var_node);
  242.         select_assign(var_node, exp_node, type_name);
  243.         break;
  244.  
  245.     /*  5.3 If statement */
  246.     case(as_if):
  247.         if_list_node = N_AST1(node);
  248.         else_node = N_AST2(node);
  249.         end_if = new_unique_name("end_if");
  250.         condition_list  = tup_copy(N_LIST(if_list_node));
  251.         /* tup_copy needed since condition_list used in tup_fromb below */
  252.         while (tup_size(condition_list)) {
  253.             n = (Node) tup_fromb(condition_list);
  254.             cond_node = N_AST1(n);
  255.             body_node = N_AST2(n);
  256.             else_part = new_unique_name("else");
  257.             gen_condition(cond_node, else_part, FALSE);
  258.             compile(body_node);
  259.             if ((tup_size(condition_list) != 0) || (else_node != OPT_NODE))
  260.                 gen_s(I_JUMP, end_if);
  261.             gen_s(I_LABEL, else_part);
  262.         }
  263.  
  264.         if (else_node != OPT_NODE)
  265.             compile(else_node);
  266.  
  267.         gen_s(I_LABEL, end_if);
  268.         break;
  269.  
  270.     /* 5.4 Case statements */
  271.     case(as_case):
  272.         exp_node = N_AST1(node);
  273.         cases_node = N_AST2(node);
  274.         gen_value(exp_node);
  275.         tup = make_case_table(cases_node);
  276.         case_table = (Tuple) tup[1];
  277.         case_bodies = (Tuple) tup[2];
  278.         others_node = (Node) tup[3];
  279.         gen_case(case_table, case_bodies, others_node,
  280.           kind_of(get_type(exp_node)));
  281.         break;
  282.  
  283.     /* 5.5 Loop statements */
  284.     case(as_loop):
  285.         gen_loop(node);
  286.         break;
  287.  
  288.     /* 5.6 Block statements */
  289.     case(as_block):
  290.         id_node = N_AST1(node);
  291.         decl_node = N_AST2(node);
  292.         stmts_node = N_AST3(node);
  293.         handler_node = N_AST4(node);
  294.         compile_body(decl_node, stmts_node, handler_node, TRUE);
  295.         break;
  296.  
  297.     case(as_end):
  298.         gen(I_EXIT_BLOCK);
  299.         break;
  300.  
  301.     /* 5.7 Exit statements */
  302.     case(as_exit):
  303.         cond_node = N_AST2(node);
  304.         label_name     = N_UNQ(node);
  305.         if (cond_node != OPT_NODE) {
  306.             dont_exit = new_unique_name("continue");
  307.             gen_condition(cond_node, dont_exit, FALSE);
  308.         }
  309.         labtup = labelmap_get(label_name);
  310.         if (labtup == (Tuple)0)
  311.             chaos("as_exit label map undefined");
  312.         lablev = (int) labtup[LABEL_STATIC_DEPTH];
  313.         for (i = lablev;i<CURRENT_LEVEL; i++)
  314.             gen(I_EXIT_BLOCK);
  315.         gen_s(I_RESTORE_STACK_POINTER, label_name);
  316.         gen_s(I_JUMP, label_name);